home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / percnt.zip / WNDFNPER.PAS < prev   
Pascal/Delphi Source File  |  1991-11-12  |  17KB  |  453 lines
  1. {***************************************************************************
  2.  
  3.     Percent Control Window Procedure Unit        $Version$
  4.         Window Function Unit
  5.         $Author$        $Date$
  6.  
  7.         Copyright 1991 Anthony M. Vitabile
  8.  
  9.         Unit Description
  10.  
  11.         This Turbo Pascal for Windows unit contains the code that
  12.         implements the window function for a new kind of control window
  13.         for use in dialog boxes.  The behavior of the control is
  14.         determined by the code contained in this function.
  15.  
  16.         The library uses straight Windows calls and does NOT use Object-
  17.         Windows.  This is to allow the control to be used by ANY Windows
  18.         program.
  19.  
  20. ***************************************************************************}
  21.  
  22. Unit WndFnPercentCtrl;
  23. Interface
  24.   Uses WinTypes;
  25.  
  26.   function PercentCtrlWndFn(HWindow:  HWnd;
  27.                             Message,
  28.                             wParam :  word;
  29.                             lParam :  longint
  30.                            ):  longint; export;
  31.  
  32. Implementation
  33.   Uses CtrlCommonDefs, Strings, WinProcs;
  34.  
  35.   function GetPercentage(HWindow:  HWnd):  integer;
  36.     begin    { GetPercentage }
  37.       GetPercentage := GetWindowWord(HWindow, Pct_Percentage);
  38.     end        { GetPercentage };
  39.  
  40.   procedure DrawAxis(HWindow:  HWnd;
  41.                      DC     :  HDC;
  42.                  var Rect   :  TRect;
  43.                      BorderW:  integer;
  44.                      Style  :  longint);
  45.     var
  46.       Extent ,
  47.       i      ,
  48.       Mult   ,
  49.       NoTicks,
  50.       Percent,
  51.       X      :  word;
  52.       Width  :  single;
  53.       Txt    :  array [0 .. 3] of char;
  54.       Temp   :  string[3];
  55.  
  56.     begin    { DrawAxis }
  57.       if Style and Pct_Decades <> 0    { Determine how many points between ticks }
  58.        then Mult := 10
  59.        else
  60.         if Style and Pct_Quarters <> 0
  61.          then Mult := 25
  62.          else Mult := 50;
  63.       NoTicks := 100 div Mult;        { Determine the number of ticks on the bar }
  64.       Width   := (Rect.right - Rect.left - 2 * BorderW) / NoTicks;
  65.       X       := Rect.left + BorderW;
  66.       for i := 0 to NoTicks do
  67.         begin
  68.           Percent := i * Mult;        { Compute the current percentage to print }
  69.           Str(Percent:1, Temp);
  70.           StrPCopy(Txt, Temp);
  71.           Extent     := LoWord(GetTextExtent(DC, Txt, StrLen(Txt)));
  72.           Rect.left  := round(i * Width - Extent / 2) + X;
  73.           Rect.right := Rect.left + Extent;
  74.           DrawText(DC, Txt, 3, Rect, dt_Left)
  75.         end
  76.     end        { DrawAxis };
  77.  
  78.   procedure DrawShadow(HWindow:  HWnd;
  79.                        DC     :  HDC;
  80.                    var Rect   :  TRect;
  81.                        Up     :  boolean;
  82.                        Offset :  integer);
  83.     var
  84.       NewPen,
  85.       OldPen:  HPen;
  86.  
  87.     begin    { DrawShadow }
  88.       if Up                { Set up Working rectangle for drawing shadows, etc }
  89.        then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window))
  90.        else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow));
  91.       if NewPen = 0
  92.        then OldPen := 0
  93.        else OldPen := SelectObject(DC, NewPen);
  94.       MoveTo(DC, Rect.left  + (Offset + 1), Rect.bottom - (Offset + 2));
  95.       LineTo(DC, Rect.left  + (Offset + 1), Rect.top    + (Offset + 1));
  96.       LineTo(DC, Rect.right - (Offset + 2), Rect.top    + (Offset + 1));
  97.       MoveTo(DC, Rect.left  + (Offset + 2), Rect.bottom - (Offset + 3));
  98.       LineTo(DC, Rect.left  + (Offset + 2), Rect.top    + (Offset + 2));
  99.       LineTo(DC, Rect.right - (Offset + 3), Rect.top    + (Offset + 2));
  100.       if OldPen <> 0
  101.        then DeleteObject(SelectObject(DC, OldPen));
  102.       if Up                { Set up Working rectangle for drawing shadows, etc }
  103.        then NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_BtnShadow))
  104.        else NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_Window));
  105.       if NewPen = 0
  106.        then OldPen := 0
  107.        else OldPen := SelectObject(DC, NewPen);
  108.       MoveTo(DC, Rect.right - (Offset + 2), Rect.top    + (Offset + 1));
  109.       LineTo(DC, Rect.right - (Offset + 2), Rect.bottom - (Offset + 2));
  110.       LineTo(DC, Rect.left  + (Offset + 1), Rect.bottom - (Offset + 2));
  111.       MoveTo(DC, Rect.right - (Offset + 3), Rect.top    + (Offset + 2));
  112.       LineTo(DC, Rect.right - (Offset + 3), Rect.bottom - (Offset + 3));
  113.       LineTo(DC, Rect.left  + (Offset + 2), Rect.bottom - (Offset + 3));
  114.       if OldPen <> 0
  115.        then DeleteObject(SelectObject(DC, OldPen))
  116.     end        { DrawShadow };
  117.  
  118.   procedure DrawButton(HWindow:  HWnd;
  119.                        DC     :  HDC;
  120.                    var Rect   :  TRect;
  121.                        Up     :  boolean);
  122.     var
  123.       NewBrush,
  124.       OldBrush:  HBrush;
  125.       NewPen  ,
  126.       OldPen  :  HPen;
  127.       Offset  :  integer;
  128.  
  129.     begin    { DrawButton }
  130.       NewBrush := CreateSolidBrush(GetSysColor(color_BtnFace));
  131.       if NewBrush = 0            { Use the new brush if it was made }
  132.        then OldBrush := 0
  133.        else OldBrush := SelectObject(DC, NewBrush);
  134.       NewPen := CreatePen(ps_Solid, 1, GetSysColor(color_WindowFrame));
  135.       if NewPen = 0
  136.        then OldPen := 0
  137.        else OldPen := SelectObject(DC, NewPen);
  138.       Rectangle(DC, Rect.left, Rect.top, Rect.right, Rect.bottom);
  139.       if OldBrush <> 0            { Restore the original brush now! }
  140.        then
  141.          begin
  142.            SelectObject(DC, OldBrush);
  143.            DeleteObject(NewBrush)
  144.          end;
  145.       if OldPen <> 0
  146.        then
  147.          begin
  148.            SelectObject(DC, OldPen);
  149.            DeleteObject(NewPen)
  150.          end;
  151.       if Up
  152.        then Offset := 0
  153.        else Offset := 2;
  154.       DrawShadow(HWindow, DC, Rect, Up, Offset)
  155.     end        { DrawButton };
  156.  
  157.   procedure DrawBar(HWindow:  HWnd; DC:  HDC; var Rect:  TRect);
  158.     var
  159.       Percent:  integer;
  160.       PctRect:  TRect;
  161.  
  162.     begin    { DrawBar }
  163.            { First draw the rectangle for the bar }
  164.       DrawButton(HWindow, DC, Rect, FALSE);
  165.  
  166.             { Draw the percentage rectangle }
  167.  
  168.       Percent := GetPercentage(HWindow);
  169.       if Percent > 0            { If there's something to be displayed }
  170.        then                { then draw the rectangle }
  171.          begin
  172.            PctRect := Rect;        { Percent rectangle is inside bar rectangle }
  173.            PctRect.right := PctRect.left   +    { Compute how far to the right the bar is! }
  174.                             round((Rect.right - Rect.left) *
  175.                                   GetPercentage(HWindow) / 100) + 1;
  176.            if PctRect.right > Rect.right
  177.              then PctRect.right := Rect.right;
  178.            DrawButton(HWindow, DC, PctRect, TRUE)
  179.         end
  180.     end        { DrawBar };
  181.  
  182.   procedure DrawDigits(HWindow:  HWnd; DC:  HDC; var Rect:  TRect);
  183.     var
  184.       i   :  integer;
  185.       Txt :  array [0 .. 4] of char;
  186.       Temp:  string[4];
  187.  
  188.     begin    { DrawDigits }
  189.       i := GetPercentage(HWindow);
  190.       Str(i:3, Temp);
  191.       Temp := Temp + '%';
  192.       StrPCopy(Txt, Temp);
  193.       i := SetBkMode(DC, Transparent);
  194.       DrawText(DC, Txt, length(Temp), Rect, dt_Center or dt_VCenter);
  195.       if i <> 0
  196.        then SetBkMode(DC, i)
  197.     end        { DrawDigits };
  198.  
  199.   procedure DrawTicks(HWindow:  HWnd;
  200.                       DC     :  HDC;
  201.                   var Rect   :  TRect;
  202.                       Style  :  longint);
  203.     var
  204.       i      ,
  205.       Mult   ,
  206.       NoTicks,
  207.       X      :  word;
  208.       Width  :  single;
  209.  
  210.     begin    { DrawTicks }
  211.       if Style and Pct_Decades <> 0    { Determine how many points between ticks }
  212.        then Mult := 10
  213.        else
  214.         if Style and Pct_Quarters <> 0
  215.          then Mult := 25
  216.          else Mult := 50;
  217.       NoTicks := 100 div Mult;        { Determine the number of ticks on the bar }
  218.       Width   := (Rect.right - Rect.left) / NoTicks;
  219.       for i := 0 to NoTicks do
  220.         begin
  221.           X := round(i * Width + Rect.left);
  222.           if (X >= Rect.right)
  223.            then X := Rect.right - 1;
  224.           MoveTo(DC, X, Rect.top);
  225.           LineTo(DC, X, Rect.bottom)
  226.         end
  227.     end        { DrawTicks };
  228.  
  229.   procedure DrawTitle(HWindow:  HWnd;
  230.                       DC     :  HDC;
  231.                   var Rect   :  TRect);
  232.     var
  233.       len :  integer;
  234.       Temp:  array [0 .. ctlTitle] of char;
  235.  
  236.     begin    { DrawTitle }
  237.       len := GetWindowText(HWindow, Temp, sizeof(Temp));
  238.       if len > 0
  239.        then DrawText(DC, Temp, len, Rect, dt_Center or dt_VCenter)
  240.     end        { DrawTitle };
  241.  
  242.   procedure EraseBackground(HWindow:  HWnd; DC:  hDC);
  243.     var
  244.       Brush ,
  245.       OBrush,
  246.       NBrush,
  247.       WBrush:  hBrush;
  248.       Parent:  HWnd;
  249.       LBrush:  TLogBrush;
  250.       CRect :  TRect;
  251.  
  252.     begin    { EraseBackground }
  253.       WBrush := GetStockObject(White_Brush);    { We may need this! }
  254.       OBrush := SelectObject(DC, WBrush);    { Get the currently selected brush }
  255.       SelectObject(DC, OBrush);            { Put the original brush back }
  256.       Parent := GetParent(HWindow);        { Get the window's parent }
  257.       if Parent <> 0                { If the control is indeed a child window }
  258.         then                    { Have the parent tell us what brush to use }
  259.           Brush := LoWord(SendMessage(Parent, wm_CtlColor, DC, MakeLong(HWindow, ctlcolor_Static)))
  260.         else Brush := WBrush;            { Otherwise use the white brush }
  261.       GetObject(Brush, sizeof(LBrush), @LBrush);{ Get the brush's data }
  262.       NBrush := CreateBrushIndirect(LBrush);    { Create a brand new brush from data returned above }
  263.       UnrealizeObject(NBrush);            { Align the brush pattern }
  264.       SelectObject   (DC, NBrush);        { Select the brush }
  265.       GetClientRect  (HWindow, CRect);        { Get the area to be erased }
  266.       FillRect       (DC, CRect, Brush);    { Erase the background }
  267.       if Brush <> WBrush            { If the background isn't white, draw the shadow }
  268.         then DrawShadow(HWindow, DC, CRect, FALSE, 0);
  269.       DeleteObject(SelectObject(DC, OBrush))    { Restore the original brush & delete our temp one }
  270.     end        { EraseBackground };
  271.  
  272.   procedure PaintPercentCtrl(HWindow:  HWnd);
  273.     var
  274.       HasAxis ,
  275.       HasPct  ,
  276.       HasTicks,
  277.       HasTitle:  boolean;
  278.       DC      :  HDC;
  279.       AxisH   ,
  280.       BarH    ,
  281.       BarW    ,
  282.       BorderW ,
  283.       CharH   ,
  284.       CharW   ,
  285.       Height  ,
  286.       TickH   ,
  287.       TitleH  ,
  288.       WhiteH  ,
  289.       Width   :  integer;
  290.       Style   :  longint;
  291.       Paint   :  TPaintStruct;
  292.       CRect   ,
  293.       Rect    :  TRect;
  294.  
  295.     begin    { PaintPercentCtrl }
  296.       DC := BeginPaint(HWindow, Paint);        { Begin the painting process }
  297.       GetClientRect(HWindow, CRect);        { Get the area covered by the window }
  298.       Style := GetDialogBaseUnits;        { Get the dialog base units }
  299.       CharH := HiWord(Style);            { Store the height of a character }
  300.       CharW := LoWord(Style);            { Store the width  of a character }
  301.  
  302.       { Set up the variables for drawing the 3 parts of the control }
  303.  
  304.       Height   := CRect.bottom - CRect.top;    { Compute the client rectangle's height }
  305.       Width    := CRect.right  - CRect.left;    { Compute the client rectangle's width }
  306.       Style    := GetWindowLong(HWindow, gwl_Style);    { Get the window's style bits }
  307.  
  308.       HasAxis  := Style and Pct_Axis   <> 0;
  309.       HasPct   := Style and Pct_Digits <> 0;
  310.       HasTicks := Style and (Pct_Decades or Pct_Quarters or Pct_Halves) <> 0;
  311.       HasTitle := GetWindowTextLength(HWindow) > 0;
  312.  
  313.       if not HasAxis                { Determine the width of the border }
  314.        then BorderW := 0
  315.        else BorderW := CharW * 5 div 2;
  316.       if BorderW >= Width div 4
  317.        then BorderW := 0;
  318.  
  319.       BarW := Width - BorderW * 2;        { Determine the width of the percentage bar }
  320.       if BarW < BorderW
  321.        then BarW := Width;
  322.  
  323.       if not HasAxis                { Determine the height of the axis }
  324.        then AxisH := 0
  325.        else AxisH := CharH;
  326.       if not HasTicks                { Determine the height of the ticks }
  327.        then TickH := 0
  328.        else TickH := CharH div 2;
  329.       WhiteH := CharH div 4;            { Compute white space height }
  330.       if not HasTitle
  331.        then TitleH := 0
  332.        else TitleH := CharH;
  333.  
  334.       BarH := Height;                { Compute bar height }
  335.       if HasTitle and                { If the control has a title }
  336.          (BarH - TitleH - WhiteH * 2 > 0)    { And it fits in the space we have }
  337.        then BarH := BarH - TitleH - WhiteH * 2;{ Then adjust the bar height for the title }
  338.       if HasTicks and                { If the control has tick marks }
  339.          (BarH - TickH - WhiteH div 2 > 0)    { And they fit in the space we have }
  340.        then BarH := BarH - TickH - WhiteH div 2;{ Then adjust the bar height for the tick marks }
  341.       if HasAxis and                { If the control has an axis }
  342.          (BarH - AxisH - WhiteH > 0)        { And it fits in the space we have }
  343.        then BarH := BarH - AxisH - WhiteH;
  344.  
  345.                                 { Draw the Title }
  346.  
  347.       Rect.top    := CRect.top;            { Compute the top    coordinate of the rectangle }
  348.       Rect.left   := CRect.left  + BorderW;    { Compute the left   coordinate of the rectangle }
  349.       Rect.right  := CRect.right - BorderW;    { Compute the right  coordinate of the rectangle }
  350.       if HasTitle
  351.        then
  352.         begin
  353.          Rect.top    := Rect.top + WhiteH;    { Compute the top    coordinate of the Title rectangle }
  354.          Rect.bottom := Rect.top + TitleH;    { Compute the bottom coordinate of the Title rectangle }
  355.          DrawTitle(HWindow, DC, Rect);
  356.          Rect.top := Rect.bottom + WhiteH    { Prepare the top    coordinate of the bar rectangle }
  357.         end;
  358.  
  359.                       { Draw the % bar }
  360.  
  361.       Rect.bottom := Rect.top + BarH;        { Compute the bottom coordinate of the bar rectangle }
  362.       DrawBar(HWindow, DC, Rect);        { Draw the bar on the display }
  363.       if HasPct                    { Draw the percent digits if this style is on }
  364.        then
  365.         begin
  366.          Rect.top    := Rect.top +         { Compute the bounding rect for the percent display }
  367.                         (BarH - CharH) div 2;
  368.          Rect.bottom := Rect.top + CharH;
  369.          DrawDigits(HWindow, DC, Rect);
  370.          Rect.top := Rect.top -            { Restore the rectangle }
  371.                      (BarH - CharH) div 2
  372.         end;
  373.  
  374.       if HasTicks                { Draw the axis tickmarks }
  375.        then
  376.         begin
  377.          Rect.top    := Rect.top + BarH;    { Compute the top    coordinate of the ticks rectangle }
  378.          Rect.bottom := Rect.top + TickH;    { Compute the bottom coordinate of the ticks rectangle }
  379.          DrawTicks(HWindow, DC, Rect, Style)    { Draw the tick marks }
  380.         end;
  381.  
  382.       if HasAxis        { Draw the axis labels }
  383.        then
  384.         begin
  385.          Rect.top    := Rect.bottom +        { Compute the top    coordinate of the ticks rectangle }
  386.                         WhiteH div 2;
  387.          Rect.bottom := Rect.top + AxisH;    { Compute the bottom coordinate of the ticks rectangle }
  388.          Rect.left   := CRect.left;
  389.          Rect.right  := CRect.right;
  390.          DrawAxis(HWindow, DC, Rect, BorderW, Style)    { Draw the axis labels }
  391.         end;
  392.  
  393.       EndPaint(HWindow, Paint)
  394.     end        { PaintPercentCtrl };
  395.  
  396.   procedure SetPercentage(HWindow:  HWnd; Pct:  integer);
  397.     begin    { SetPercentage }
  398.       SetWindowWord (HWindow, Pct_Percentage, Pct)
  399.     end        { SetPercentage };
  400.  
  401.   function PercentCtrlWndFn(HWindow:  HWnd;
  402.                             Message,
  403.                             wParam :  word;
  404.                             lParam :  longint
  405.                            ):  longint;
  406.     var
  407.       x     :  integer;
  408.       result:  longint;
  409.  
  410.     begin    { PercentCtrlWndFn }
  411.       result := ord(TRUE);
  412.       case Message of
  413.         wm_Create       :
  414.           begin
  415.             SetPercentage(HWindow, 0);
  416.             result := word(FALSE)
  417.           end;
  418.         wm_Paint        :  PaintPercentCtrl(HWindow);
  419.         wm_NCHitTest    :  result := htTransparent;
  420.         wm_EraseBkgnd   :  EraseBackground(HWindow, wParam);
  421.         pcm_ResetPercent:
  422.           begin
  423.             SetPercentage (HWindow, 0);
  424.             InvalidateRect(HWindow, nil, TRUE)
  425.           end;
  426.         pcm_AddPercent  :
  427.           begin
  428.             x := integer(wParam);
  429.             x := x + GetPercentage(HWindow);
  430.             if x < 0
  431.              then x := 0;
  432.             if x > 100
  433.              then x := 100;
  434.             SetPercentage (HWindow, x);
  435.             InvalidateRect(HWindow, nil, TRUE)
  436.           end;
  437.         pcm_GetPercent  : result := GetPercentage(HWindow);
  438.         pcm_SetPercent  :
  439.           begin
  440.             x := integer(wParam);
  441.             if x < 0
  442.              then x := 0;
  443.             if x > 100
  444.              then x := 100;
  445.             SetPercentage (HWindow, x);
  446.             InvalidateRect(HWindow, nil, TRUE)
  447.           end;
  448.        else result := DefWindowProc(HWindow, Message, wParam, lParam)
  449.       end;
  450.       PercentCtrlWndFn := result
  451.     end        { PercentCtrlWndFn };
  452.  
  453.   end.